Hottest 6/Hottest 6 (1996)(PDSoft)[!].iso/software/fredfish/1059.lha/Programs/MathPlot/Macros/GridLines.mapl

Text File | 1994-12-15 | 4KB | 258 lines

/* Plots a grid. */
/* Version 1.00, 07.08.1993 */

options results


IF ~SHOW('L','rexxmathlib.library') THEN
   CALL ADDLIB('rexxmathlib.library',0,-30)

/* OK, MathPlot will clear the screen before every plot when there */
/* was no REAL plot before. So we have to do some trick to get a   */
/* real plot....                                                   */
/* If you do not understand this: Try this script and then plot    */
/* another function or the axis. Then delete the next lines, clear */
/* screen and do it again. The first time, you will se both        */
/* functions, the second time only the last function.              */

getfunc 0
a = result

setfunc 0 10000
plot 0 normal

setfunc 0 a

/* End of trick.... */



/* First, get some infos from the program */

getintervall2 stem intervall.
evalstring intervall.xmin
xmn = result
evalstring intervall.xmax
xmp = result
evalstring intervall.ymin
ymn = result
evalstring intervall.ymax
ymp = result
evalstring intervall.xminreal
xmnr = result
evalstring intervall.xmaxreal
xmpr = result
evalstring intervall.yminreal
ymnr = result
evalstring intervall.ymaxreal
ympr = result

info stem b.
colors = b.colors




/* Calc the tics */
xtics = maketics(xmn, xmp, 0, 10)
ytics = maketics(ymn, ymp, 0, 10)

flx = floor(xmn/xtics)
fly = floor(ymn/ytics)
clx = ceil(xmp/xtics)
cly = ceil(ymp/ytics)

/* Draw the tics */
drawtics(xtics*flx, xtics, xtics*clx,
        ,ytics*fly, ytics, ytics*cly)
exit

/* ------------------------------------------------------------*/
/* Function MakeTics */
maketics:
parse arg tmin, tmax, logscale, baselog

x = tmin-tmax

xr  = fabs(x)
l10 = log10(xr)
if(l10 >= 0.0) then do
 i = floor(l10)
 end
else do
 i = ceil(l10-1.0)
end

if(logscale) then do
  tic = raise(baselog, i)
 if(tic < 1.0) then tic = 1.0
end
else do
 xnorm = pow(10.0, l10-i)
 if(xnorm <= 2.01) then do
  tics = 0.2
  end
 else do
  if(xnorm <= 5) then do
   tics = 0.5
   end
  else do
   tics = 1.0
  end
 end
  tic = tics * raise(10.0,i)
end
return tic


/* ------------------------------------------------------------*/
/* Function RAISE */
raise:
parse arg x,y

val = 1.0
do i=0 to abs(y)-1
 val = val*x
end

if(y < 0) then val = 1/val

return val


/* ------------------------------------------------------------*/
/* DrawTics */
drawtics:
parse arg xstart, xdiff, xendorig, ystart, ydiff, yendorig


/* Round a bit */
xend = xendorig * 1.001
yend = yendorig * 1.001

a = 0
b = 0

e    = exp(1)
pi   = 2*acos(0)
ln10 = ln(10)


select
 when intervall.xmode=0 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1
   a   = a+1
  end
 end
 when intervall.xmode=1 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1*e
   a   = a+1
  end
 end
 when intervall.xmode=2 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1*pi
   a   = a+1
  end
 end
 when intervall.xmode=3 then do
  do pos1 = xstart to xend by xdiff
   x.a   = exp(pos1)
   a   = a+1
  end
 end
 when intervall.xmode=4 then do
  do pos1 = xstart to xend by xdiff
   x.a   = exp(pos1*ln10)
   a   = a+1
  end
 end
 otherwise nop
end


select
 when intervall.ymode=0 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1
   b   = b+1
  end
 end
 when intervall.ymode=1 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1*e
   b   = b+1
  end
 end
 when intervall.ymode=2 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1*pi
   b   = b+1
  end
 end
 when intervall.ymode=3 then do
  do pos1 = ystart to yend by ydiff
   y.b   = exp(pos1)
   b   = b+1
  end
 end
 when intervall.ymode=4 then do
  do pos1 = ystart to yend by ydiff
   y.b   = exp(pos1*ln10)
   b   = b+1
  end
 end
 otherwise nop
end




/* Reset plotcolor */
getcolor plotcolor
oldcolor = result

/* Ask plotcolor */
/* First generate the button-string */
select
 when colors = 2 then do
  but = "1|Cancel"
 end
 when colors = 4 then do
  but = "1|2|3|Cancel"
 end
 when colors = 8 then do
  but = "1|2|3|4|5|6|7|Cancel"
 end
 when colors = 16 then do
  but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
 end
 when colors = 32 then do
  /* 32 colors does not make sense here */
  but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
 end
end

text = 'title "GridLines" prompt "Select a color" button ' || but

/* Now ask */
requestresponse text

if RC == 5 then exit

setcolor plotcolor result

/* Plot the grid */
do i=0 to a-1
    line x.i ympr x.i ymnr
end
do j=0 to b-1
    line xmnr y.j xmpr y.j
end

setcolor plotcolor oldcolor

return 0